home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0157_Show Mono PCX file.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  1.8 KB  |  96 lines
  1. Program Display;
  2.  
  3. Uses Crt;
  4.  
  5. procedure loadpcx(fname:string);
  6. var f             : file ;
  7.     buf           : array[1..16] of byte;
  8.     pcxdata,palet : pointer ;
  9.     pcxlen        : word;
  10.  
  11. begin
  12.    assign(f,fname);
  13.    {$I-}
  14.    reset(f,1);
  15.    if ioresult<>0 then exit; { couldnt open file}
  16.    blockread(f,buf,16);
  17.    if ioresult<>0 then exit; { Read error }
  18.    if buf[1]<>$0a then exit;  {no pcx file}
  19.    if (buf[2]<>5) or (buf[4]<>8) then exit; {no 256 colors}
  20.    if (buf[13]<>$40) or (buf[14]<>$01) or (buf[15]<>$c8) or (buf[16]<>0)
  21.    then Exit;
  22.  
  23.    pcxlen:=filesize(f)-128-768;
  24.    getmem(pcxdata,pcxlen);
  25.    seek(f,128);
  26.    blockread(f,pcxdata^,pcxlen);
  27.    if ioresult<>0 then exit;
  28.    {$I+}
  29. {---- read body ----}
  30.    asm
  31.      push ds
  32.      Mov DI,$A000
  33.      Mov ES,DI
  34.      And Di,0
  35.      lds si,pcxdata
  36.      mov bx,di
  37.      add bx,64000
  38. @nextpcxbyte:
  39.      mov al,[si]
  40.      inc si
  41.      mov cl,al
  42.      and cl,$c0
  43.      cmp cl,$c0
  44.      je @herhaling
  45.      mov cl,1
  46. @verder:
  47.      rep stosb
  48.      cmp di,bx
  49.      je @end
  50.      jmp @nextpcxbyte
  51. @herhaling:
  52.      mov cl,al
  53.      and cl,$3f
  54.      mov al,[si] ; inc si
  55.      jmp @verder
  56. @end: pop ds
  57.    end;
  58.  
  59. {-------- read palette --------}
  60.       seek(f,filesize(f)-768);
  61.       GetMem(palet,768);
  62.       blockread(f,palet^,768);
  63.       if ioresult<>0 then exit;
  64.       asm
  65.         les di,palet
  66.            mov ax,768
  67.         mov cl,2
  68.        @1:
  69.         shr es:[di],cl
  70.         inc di
  71.         dec ax
  72.            jnz @1
  73.         mov ax,$1012
  74.         mov bx,0
  75.         mov cx,255;
  76.         les dx,palet
  77.         int $10
  78.       end;
  79.    close(f);
  80. end;
  81.  
  82. Begin
  83.  
  84.   Asm Mov AX,$13; Int $10 End;
  85.  
  86.   IF Paramcount > 0 THEN
  87.      BEGIN
  88.      LoadPcx(ParamStr(1));
  89.      ReadLn;
  90.      END;
  91.  
  92.   Asm Mov AX,$3; Int $10 End;
  93.  
  94. End.
  95.  
  96.